Data Wrangling

I got the data from a Kaggle website ( https://www.kaggle.com/NUFORC/ufo-sightings ) It contains a dataset of 80332 ufo sightings across the world collected over the last century.

Inspect Data

ufos_raw <- read_csv("ufos-scrubbed.csv") %>% 
  filter(country == "us")
head(ufos_raw) %>% kable("html")
datetime city state country shape duration (seconds) duration (hours/min) comments date posted latitude longitude
10/10/1949 20:30 san marcos tx us cylinder 2700 45 minutes This event took place in early fall around 1949-50. It occurred after a Boy Scout meeting in the Baptist Church. The Baptist Church sit 4/27/2004 29.88306 -97.94111
10/10/1956 21:00 edna tx us circle 20 1/2 hour My older brother and twin sister were leaving the only Edna theater at about 9 PM&#44…we had our bikes and I took a different route home 1/17/2004 28.97833 -96.64583
10/10/1960 20:00 kaneohe hi us light 900 15 minutes AS a Marine 1st Lt. flying an FJ4B fighter/attack aircraft on a solo night exercise&#44 I was at 50&#44000&#39 in a &quot;clean&quot; aircraft (no ordinan 1/22/2004 21.41806 -157.80361
10/10/1961 19:00 bristol tn us sphere 300 5 minutes My father is now 89 my brother 52 the girl with us now 51 myself 49 and the other fellow which worked with my father if he&#39s still livi 4/27/2007 36.59500 -82.18889
10/10/1965 23:45 norwalk ct us disk 1200 20 minutes A bright orange color changing to reddish color disk/saucer was observed hovering above power transmission lines. 10/2/1999 41.11750 -73.40833
10/10/1966 20:00 pell city al us disk 180 3 minutes Strobe Lighted disk shape object observed close&#44 at low speeds&#44 and low altitude in Oct 1966 in Pell City Alabama 3/19/2009 33.58611 -86.28611

Data prepping

-Text wrap comments column so that hover visualization shows multi-line output

-Coerce datetime into date format and extract Year & Year/Month as a new columns.

#Data transformation
ufos_raw$comments <- str_wrap(ufos_raw$comments, 50)
ufos_raw$year <-format(as.Date(ufos_raw$datetime,format="%m/%d/%Y"),"%Y")
ufos_raw$month <-format(as.Date(ufos_raw$datetime,format="%m/%d/%Y"),"%Y/%m")

Filter down data to just the columns we need for visualization.

#Select just the data needed
ufos <- ufos_raw %>% 
  filter(year >= '2000') %>% 
  select(c(datetime, latitude, longitude, month, comments, state, city, year, shape))
head(ufos) %>% kable("html")
datetime latitude longitude month comments state city year shape
10/10/2000 03:00 37.72417 -89.86111 2000/10 The craft was big&#44 orange&#44 and oval shaped. mo perryville 2000 oval
10/10/2000 06:15 26.52500 -80.06667 2000/10 Unusual light formation moving extremely fast across the sky. fl boynton beach 2000 other
10/10/2000 20:30 38.12667 -92.08444 2000/10 3 bright golden lights moving independently above the tree line flaring and fading intermittently for approx. 15 min. mo brinktown 2000 light
10/10/2000 21:30 38.99889 -84.62667 2000/10 Two objects traveling side by side pass over&#44 as one begins to zig&#44 zag it&#39s path. ky florence 2000 light
10/10/2000 21:30 47.60639 -122.33083 2000/10 Dark object in the shape of a (4) after dusk in West Seattle wa seattle (west) 2000 unknown
10/10/2000 22:00 47.54056 -122.63500 2000/10 One night my window started to flash wa port orchard 2000 diamond

Plot of UFOs sightings animated from the year 2000 onwards

ufos %>% 
  plot_mapbox(frame = ~month) %>% #frame creates animation
  layout(
    mapbox = list(
      style = "dark", #changes map style
      zoom = 2.4, 
      center = list(lat = 37, lon = -95) #centers on USA
    )
  ) %>% 
  add_markers(
    x = ~longitude, 
    y = ~latitude,
    marker = list(size = 3, color = "#FFFFCC", opacity = 0.4), #creates glyph aesthetic
  ) %>% 
  animation_opts(100) #sets the number of milliseconds per frame 

Plot of UFO sightings cumulative from 2000.

ufos1 <- ufos %>% 
  plot_mapbox() %>% 
  layout(
    mapbox = list(
      style = "dark", 
      zoom = 2.4, 
      center = list(lat = 37, lon = -95)
    )
  ) %>% 
  add_markers(
    x = ~longitude, 
    y = ~latitude,
    marker = list(size = 2, color = "#FFFFCC", opacity = 0.2),
    text = ~paste("<b>Date/Time:</b>", datetime,"<br><b>Report:</b>", comments, "<br><b>City/State:</b>", city, ",", state),
    textposition = "auto",
    hoverlabel = list(align = "left"),
    hoverinfo = "text"
  ) 

ufos1

Reflection

I was quite frustrated about the animation. There were moments when the animation would jitter crazily when I made the frame rate higher. In order to make the animation smoother, I had to cut down the number of years it scrubbed through as well as lower the frame rate. Lots of tweaking to figure out what works.

I implemented the use of color and lightness in Wilke’s book to convey density in geospatial data. Since UFOs are often seen at night, I made the map background dark, and used light glyphs to emphasize higher intensity/concentration of sightings.

The story I am telling through this visualization is the increasing number and concentration of UFO sighting reports across the years. The animation and visualization also helps us see concentrations of regions that report sightings regularly.

Improvements

I took Tom Takeuchi’s idea of using crosstalk to create a multi-select bar for the plot, which selects years.

library(crosstalk)

ufos2 <- highlight_key(ufos, ~year)

widgets <- bscols(
  filter_select("Select a Year", "Select a Year", ufos2, ~year)
)

bscols(widths = c(3,9), widgets,
  ufos2 %>% 
  plot_mapbox() %>% 
  layout(
    mapbox = list(
      style = "dark", 
      zoom = 2.4, 
      center = list(lat = 37, lon = -95)
    )
  ) %>% 
  add_markers(
    x = ~longitude, 
    y = ~latitude,
    marker = list(size = 2, color = "#FFFFCC", opacity = 0.2),
    text = ~paste("<b>Date/Time:</b>", datetime,"<br><b>Report:</b>", comments, "<br><b>City/State:</b>", city, ",", state),
    textposition = "auto",
    hoverlabel = list(align = "left"),
    hoverinfo = "text"
  ) 
)